!############################# Change Log ##################################
! 5.0.0
!
!###########################################################################
!  Copyright (C)  1990, 1995, 1999, 2000, 2003 - All Rights Reserved
!  Regional Atmospheric Modeling System - RAMS
!###########################################################################

subroutine rams_master(ipara, nslaves, master_num, name_name)

  use grid_dims, only: &
       maxgrds,maxmach,     &
       BRAMS_version

  use rpara, only: &
       iparallel,    &
       nmachs,       &
       machnum,ixb,ixe,iyb,iye

  use mem_grid, only: &
       runtype,         &
       expnme,          &
       ngrids,          &
       nzp,             &
       nxp,             &
       nyp,             &
       isched,          &
       maxsched,        &
       maxschent,       &
       nxtnest,         &
       nndtrat,         &
       nsubs,           &
       time,            &
       timmax, nnxp,nnyp,nnzp

  use mem_oda, only:if_oda

!--(DMK-CCATT)---------------------------------------------------------
!srf-chem
  use catt_start, only: CATT                      ! intent(in) 
  use mem_chem1, only:  CHEMISTRY, CHEM_ASSIM     ! intent(in)
!srf-chem-end
!--(DMK-CCATT-END)-----------------------------------------------------

  use mem_radiate, only: ISWRTYP, ILWRTYP ! Intent(in)

  use dtset, only: dtset_new, dump_courn ! subroutine

!lfr - Walcek
  use monotonic_adv, ONLY: InitCommMatrix
!  use ParLib, only: parf_init_mpi
!lfr
  use AdvectData, only: InitAdvect
  use ErrorMod, only: CreateError,setError
  use node_mod, only : nodei0,nodej0,mmxp,mmyp
  
  implicit none

  integer, intent(in) :: ipara              ! 0 iff sequential run; 1 iff parallel run
  integer, intent(in) :: nslaves            ! number of slaves on a parallel run
  integer, intent(in) :: master_num         ! this process rank on a parallel run
  character(len=*), intent(in) :: name_name ! namelist file name

  integer, allocatable :: taskids(:)
  character(len=12) :: c0
  character(len=12) :: c1

  integer :: i,ifm,nndtflg

  real :: w1,w2,w3,wtime_start  ! wall time
  real, external :: walltime    ! wall time
  real :: t1,t2                 ! cpu time

  !ALF
  real :: dxtmax_local(maxgrds)

  !LFR
  i=CreateError(1)
  i=setError(1,'Generic Error',2,.true.)


  ! wall time 

  wtime_start=walltime(0.)
  w1=walltime(wtime_start)

  ! setup iparallel

  iparallel=ipara

  ! start graphics package (just in case we put in graphical stuff)

  call opngks

  ! read namelist file 

  call read_nl(trim(name_name))

  ! print initial banner

  write(*,"(a)") "+-----------------------------------------------------"
  write(*,"(a)") "!             "//BRAMS_version
  write(*,"(a)") "! input namelist filename is "//trim(name_name)
  write(*,"(a)") "! run name is "//trim(expnme)
  if (ipara == 0) then
     write(*,"(a)") "! single process execution on "//&
          &trim(adjustl(runtype))//" run"
  else
     write(c0,"(i12)") nslaves
     write(*,"(a)") "! parallel execution with master and "//&
          &trim(adjustl(c0))//" slave processes on "//&
          &trim(adjustl(runtype))//" run"
     if (iparallel == 0) then
        write(*,"(a)") "! converted into a sequential run for "//&
             &trim(adjustl(runtype))//" run"
     end if
  end if
  write(*,"(a)") "+-----------------------------------------------------"

  ! dump namelist

  call nameout()

  ! Various option settings that should normally not be changed
  ! (previously namelist parameters)

  call eng_params  

  ! Reset parallel flag if necessary

  if ( (runtype(1:4) == 'MAKE') .and. iparallel /= 0) then
     iparallel=0
  endif

  ! First check of options, mainly for numbers of grid points

  call opspec1

  ! Basic grid coordinate setup

  call grid_setup(1)


  ! Additional checks, mainly for nesting

  call opspec2()


  ! Check sfc,sst,ndvi files; remake if needed

  call make_sfcfiles()


  ! Behave accordingly to run type

  if (runtype(1:7) == 'MAKESFC') then

     ! done on a MAKESFC run

     write(*,"(a)") ' MAKESFC run complete'


  else if(runtype(1:9) == 'MAKEVFILE') then

     ! on a "MAKEVFILE" run, call ISAN, then exit.

!--(DMK-CCATT)---------------------------------------------------------
!srf-chem
  if(CATT==1 .and. CHEM_ASSIM ==1 .and. CHEMISTRY >= 0)then
     call chem_isan_driver(name_name)
     print*,' CHEM_ISAN complete '
  else
     call isan_driver(name_name)
     print*,' ISAN complete '
  endif
!srf-chem-end
!--(DMK-original)------------------------------------------------------
!     call isan_driver(name_name)
!--(DMK-CCATT-END)-----------------------------------------------------

     write(*,"(a)") ' MAKEVFILE run complete'


  else

     !-----------------------------------------------------------
     ! If we got here, we are doing an actual
     !    simulation (RAMS or HYPACT)
     !-----------------------------------------------------------

     ! Initialize micro arrays. May need to change some settings which affect memory.

     call jnmbinit()


     ! Allocate main memory

     if (iparallel == 0) then
        call rams_mem_alloc(0)
     else
        call rams_mem_alloc(1)
     endif


     ! Call main initialization driver

     call initlz(name_name)


     ! Compute Courant numbers cflxy and cflz.

     do ifm = 1,ngrids
        call newgrid(ifm)
        call cfl(nzp,nxp,nyp,0,0,1)
     enddo


     ! Initialize dtlongn, nndtrat, and nnacoust, and compute the timestep
     ! schedule for all grid operations.

     !call dtset(nndtflg)
     call dtset_new(0, nndtflg, dxtmax_local)

     call dump_dtset(nndtflg)

     call modsched(isched, maxsched, maxschent, ngrids, nxtnest, nndtrat, nsubs)
     call dump_modsched(isched, maxsched, maxschent, ngrids, nxtnest, nndtrat, nsubs)
     ! Dump Courant number
     call dump_courn()

     !  Initialize HYPACT configuration and sources

     if (index(runtype,'HYP') /= 0)  then
        write (*,"(a)") "ERROR** HYPACT not implemented"
        stop
     endif

     if(iparallel == 1) then

        !   ---------------------------------------------------------------
        !     Initialize parallel processes with all relevant information
        !   --------------------------------------------------------------

        allocate(taskids(nslaves))
        do i=1,nslaves
           taskids(i)=i
        end do
        print *,'lfr->1';CALL flush(6)
!!$        call par_ready(nmachs,machnum,777)
        call parf_barrier(777)
        print *,'lfr->2';CALL flush(6)
        call masterput_processid(nslaves,taskids,master_num)
        print *,'lfr->3';CALL flush(6)
        call masterput_nl()
        print *,'lfr->4';CALL flush(6)
        call masterput_gridinit()
        print *,'lfr->5';CALL flush(6)
        call node_decomp(1)



        call dump_Domain_Decomposition()
        call masterput_grid_dimens()
        call masterput_gridset()
        call masterput_cofnest()
        call masterput_micphys()
        if (ISWRTYP==4 .or. ILWRTYP==4) call masterput_carma()
        if (if_oda == 1) call masterput_oda()
        call masterput_misc()


        print *,'lfr->CALLING THE RIGHT PLACE';CALL flush(6)
        CALL  InitAdvect(ngrids,nmachs,0,2,nnxp,nnyp,nnzp,ixb,ixe,iyb,iye)

       !!lfr - monotonic advection
!              CALL InitCommMatrix(0,0)
       !lfr - monotonic advection

        call master_sendinit()
!!$        call par_ready(nmachs,machnum,777)
        call parf_barrier(777)

!!$        call timing(1,t2)
!!$        w3=walltime(wtime_start)
!!$        write(c0,"(f12.2)") t2-t1
!!$        write(c1,"(f12.2)") w3-w2
!!$        write(*,"(a)") " Master done sending basic info to slaves; CPU(sec)="//&
!!$             &trim(adjustl(c0))//"; Wall(sec)="//trim(adjustl(c1))
     end if

     call timing(1,t1)
     w2=walltime(wtime_start)
     write(c0,"(f12.2)") t1
     write(c1,"(f12.2)") w2-w1
     write(*,"(/,a,/)") " === Finish initialization; CPU(sec)="//&
          &trim(adjustl(c0))//"; Wall(sec)="//trim(adjustl(c1))//&
          &"; Time integration starts ===" 

     ! Exit if doing a zero time run
     if (time < timmax) then
        !  Call the model time integration driver
        if(iparallel == 1) then
           call par_model()
        else
           call model()
        end if
     end if
  end if

  !  RAMS finished, clean up some last things...

  if (iparallel == 1) then
     deallocate(taskids)
  end if

  call clsgks     ! call this just in case we put in graphical stuff

  return
end subroutine rams_master

!-------------------------------------------------------------------------

subroutine comm_time(isendflg,isendlite,isendmean,isendboth,isendbackflg)

  use mem_varinit
  use mem_cuparm
  use io_params
  use mem_grid

  ! CATT
  use catt_start, only: CATT           ! intent(in)

!--(DMK-CCATT)---------------------------------------------------------
  !srf - chem
  use mem_chem1, only:  CHEMISTRY
  use chem_sources, only: srctime2,SRCMAPFN
  !srf - chem - end
!--(DMK-CCATT-END)-----------------------------------------------------

  implicit none

  integer, intent(out) :: isendflg,isendlite,isendmean,isendboth,isendbackflg
  real :: timemf
  integer :: ifm
  real :: frqqueim  ! CATT

  !         ISENDFLG designates whether nodes should send back
  !            stuff things it normally doesn't have to
  !            at the end of timestep for history/analysis write,
  !            load balancing, etc.

  !         isendflg  = the usual RAMS stuff
  !         isendlite = the "lite" variables
  !         isendmean = the "mean" variasbles
  !         isendboth = Both the "mean" and "lite" variables

  !            Determines whether nodes send stuff back at the END of the
  !            timestep!!!!!

  timemf = time + dtlongn(1)
  isendflg = 0
  isendlite = 0
  isendmean = 0
  isendboth = 0
  isendbackflg = 0 ! ALF

!--(DMK-CCATT)---------------------------------------------------------
  !----srf-
  if (CATT == 1 ) then
    if (CHEMISTRY >= 0 .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'NONE' &
                       .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'none') then

       !time para leitura dos mapas de queimadas
       !frqqueim=24.*3600.
       !inicializando as fontes as 00UTC
       !if ( mod(timemf + 0.01*itime1*3600.,frqqueim) .lt. dtlongn(1) .and. &
       !     timemf.ge.0.*3600.) then
       if(timemf>=srctime2 .and. timemf<timmax) then
          isendflg = 1
          isendbackflg = 1 ! ALF
       endif
    endif
  endif
  !----srf-
!--(DMK-CCATT)---------------------------------------------------------

  if(frqlite > 0.) then
     if (mod(timemf,frqlite) < dtlongn(1)) isendlite=1
  endif

  if (frqmean > 0.) then
     if(avgtim > 0.)then
        if(mod(timemf-avgtim/2.,frqmean) < dtlongn(1) .and.  &
             timemf >= avgtim) isendmean=1
     elseif(avgtim < 0.)then
        if(mod(timemf,frqmean) < dtlongn(1)) isendmean=1
     endif
  endif
  if(runtype(1:7) == 'INITIAL'.and.timemf < dtlongn(1)) isendmean=0
  if(runtype(1:7) == 'HISTORY'.and.timemf <= timstr) isendmean=0

  if (frqboth > 0.) then
     if(avgtim > 0.)then
        if(mod(timemf-avgtim/2.,frqboth) < dtlongn(1) .and.  &
             timemf >= avgtim) isendboth=1
     elseif(avgtim < 0.)then
        if(mod(timemf,frqboth) < dtlongn(1)) isendboth=1
     endif
  endif
  if(runtype(1:7) == 'INITIAL'.and.timemf < dtlongn(1))isendboth=0
  if(runtype(1:7) == 'HISTORY'.and.timemf <= timstr)isendboth=0

  if (ioutput  /=  0) then
     if ( mod(timemf,frqanl)  <  dtlongn(1) .or.  &
          mod(timemf,frqhis)  <  dtlongn(1)) then
        isendflg = 1
        !return
     endif
  endif

  if( timemf  >=  timmax - .01*dtlongn(1) ) then
     isendflg = 1
     !return
  endif

  if  ( nud_type == 2 .and. timemf  >=  vtime2  &
       .and. timemf  <  timmax) then
     isendflg = 1
     isendbackflg = 1 ! ALF
     return
  endif

  if  ( nud_type == 1 .and. timemf  >=  htime2  &
       .and. timemf  <  timmax) then
     isendflg = 1
     isendbackflg = 1 ! ALF
     !return
  endif

  if  ( nud_cond == 1 .and. timemf  >=  condtime2  &
       .and. timemf  <  timmax) then
     isendflg = 1
     isendbackflg = 1 ! ALF
     !return
  endif

  if (mod(timemf,frqprt)  <  dtlongn(1) ) then
     isendflg = 1
     !return
  endif

  if (iupdsst  ==  1 ) then
     do ifm = 1,ngrids
        if (isstflg(ifm)  ==  1) then
           if (timemf  >=  ssttime2(ifm) .and.  &
                timemf  <  timmax) then
              isendflg = 1
              isendbackflg = 1 ! ALF
              return

           endif
        endif
     enddo
  endif

  if (iupdndvi  ==  1 ) then
     do ifm = 1,ngrids
        if (ndviflg(ifm)==1) then
           if (timemf>=ndvitime2(ifm) .and. timemf<timmax) then
              isendflg = 1
              isendbackflg = 1 ! ALF

              !return
           endif
        endif
     enddo
  endif

  if (if_cuinv  ==  1 ) then
     do ifm = 1,ngrids
        if (timemf  >=  cu_times(ncufl+1) .and.  &
             timemf  <  timmax) then
           isendflg = 1
           isendbackflg = 1 ! ALF
           !return
        endif
     enddo
  endif

  return
end subroutine comm_time

!-------------------------------------------------------------------------

subroutine comm_time_new(isendflg, isendlite, isendmean, isendboth, &
     isendbackflg, isendiv, isendsst, isendndvi)

  use mem_varinit
  use mem_cuparm
  use io_params
  use mem_grid
  ! CATT
  use catt_start, only: CATT           ! intent(in)

!--(DMK-CCATT)---------------------------------------------------------
  !srf - chem
  use mem_chem1, only:  CHEMISTRY
  use chem_sources, only: srctime2,SRCMAPFN
  !srf - chem-end
!--(DMK-CCATT)---------------------------------------------------------


  ! ALF
  use node_mod, only : mynum           ! intent(in)
  implicit none

  integer, intent(out) :: isendflg,isendlite,isendmean,isendboth,isendbackflg
  integer, intent(out) :: isendiv, isendsst, isendndvi

  real :: timemf
  real :: frqqueim  ! CATT
  integer :: ifm

  ! ALF
  integer :: iyears,imonths,idates,ihours
  character(len=14)  :: itotdate_current
  real(kind=8) :: lastdate_sec, initialdate_sec

  !         ISENDFLG designates whether nodes should send back
  !            stuff things it normally doesn't have to
  !            at the end of timestep for history/analysis write,
  !            load balancing, etc.

  !         isendflg  = the usual RAMS stuff
  !         isendlite = the "lite" variables
  !         isendmean = the "mean" variasbles
  !         isendboth = Both the "mean" and "lite" variables

  !            Determines whether nodes send stuff back at the END of the
  !            timestep!!!!!

  timemf = time + dtlongn(1)
  isendflg = 0
  isendlite = 0
  isendmean = 0
  isendboth = 0
  isendbackflg = 0 ! ALF
  isendiv = 0 ! ALF
  isendsst = 0 ! ALF
  isendndvi = 0 ! ALF

!--(DMK-CCATT)---------------------------------------------------------
  if (CATT == 1 ) then
     
     if (CHEMISTRY >= 0 .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'NONE' &
                        .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'none') then

       !time para leitura dos mapas de queimadas
       frqqueim=24.*3600.
       !inicializando as fontes as 00UTC
       !if ( mod(timemf + 0.01*itime1*3600.,frqqueim) .lt. dtlongn(1) .and. &
       !     timemf.ge.0.*3600.) then
       if(timemf>=srctime2 .and. timemf<timmax) then
     	  isendflg = 1
     	  isendbackflg = 1 ! ALF
       endif
    endif
  endif
 !----srf-

  if(frqlite > 0.) then
     if (mod(timemf,frqlite) < dtlongn(1)) isendlite=1
  endif

  if (frqmean > 0.) then
     if(avgtim > 0.)then
        if(mod(timemf-avgtim/2.,frqmean) < dtlongn(1) .and.  &
             timemf >= avgtim) isendmean=1
     elseif(avgtim < 0.)then
        if(mod(timemf,frqmean) < dtlongn(1)) isendmean=1
     endif
  endif
  if(runtype(1:7) == 'INITIAL'.and.timemf < dtlongn(1)) isendmean=0
  if(runtype(1:7) == 'HISTORY'.and.timemf <= timstr) isendmean=0

  if (frqboth > 0.) then
     if(avgtim > 0.)then
        if(mod(timemf-avgtim/2.,frqboth) < dtlongn(1) .and.  &
             timemf >= avgtim) isendboth=1
     elseif(avgtim < 0.)then
        if(mod(timemf,frqboth) < dtlongn(1)) isendboth=1
     endif
  endif
  if(runtype(1:7) == 'INITIAL'.and.timemf < dtlongn(1))isendboth=0
  if(runtype(1:7) == 'HISTORY'.and.timemf <= timstr)isendboth=0

  if (ioutput  /=  0) then
     if ( mod(timemf,frqanl)  <  dtlongn(1) .or.  &
          mod(timemf,frqhis)  <  dtlongn(1)) then
        isendflg = 1
        !return
     endif
  endif

  if( timemf  >=  timmax - .01*dtlongn(1) ) then
     isendflg = 1
     !return
  endif

  if (nud_type==2) then

     if (mynum/=0) then
        if  (timemf>=vtime2 .and. timemf<timmax) then
           isendflg = 1
           isendbackflg = 1 ! ALF
           isendiv = 1 ! ALF
        endif
     else ! Master node
        call date_make_big(iyear1,imonth1,idate1,itime1,itotdate_current)
        call date_abs_secs(itotdate_current, initialdate_sec)
        call date_abs_secs(lastdate_iv, lastdate_sec)
        if  (timemf>=vtime1 .and. timemf<timmax .and.         &
             ((lastdate_sec-initialdate_sec)+.0001)<timmax) then
           call date_add_to(iyear1,imonth1,idate1,itime1*100  &
                ,timmax,'s',iyears,imonths,idates,ihours)
           call date_make_big(iyears,imonths,idates,ihours,itotdate_current)
           if (lastdate_iv<itotdate_current) then
              isendflg = 1
              isendbackflg = 1 ! ALF
              isendiv = 1 ! ALF
           endif
        endif
        !return
     endif

  endif

  if  ( nud_type == 1 .and. timemf  >=  htime2  &
       .and. timemf  <  timmax) then
     isendflg = 1
     isendbackflg = 1 ! ALF
     !return
  endif

  if  ( nud_cond == 1 .and. timemf  >=  condtime2  &
       .and. timemf  <  timmax) then
     isendflg = 1
     isendbackflg = 1 ! ALF
     !return
  endif

  if (mod(timemf,frqprt)  <  dtlongn(1) ) then
     isendflg = 1
     !return
  endif

  if (iupdsst  ==  1 ) then

     if (mynum/=0) then ! Slave Process
        do ifm = 1,ngrids
           if (isstflg(ifm)==1) then
              if (timemf>=ssttime2(ifm) .and. timemf<timmax) then
                 isendflg = 1
                 isendbackflg = 1 ! ALF
                 isendsst = 1 ! ALF
                 !return
              endif
           endif
        enddo
     else
        ! Master Process
        ! First, checking if all values have been read
        call date_make_big(iyear1,imonth1,idate1,itime1,itotdate_current)
        call date_abs_secs(itotdate_current, initialdate_sec)
        do ifm = 1,ngrids
           call date_abs_secs(lastdate_sst(ifm), lastdate_sec)
           if (isstflg(ifm)==1 .and. timemf>=ssttime1(ifm) .and. &
                timemf<timmax .and. &
                ((lastdate_sec-initialdate_sec)+.0001)<timmax) then
              call date_add_to(iyear1,imonth1,idate1,itime1*100  &
                   ,timmax,'s',iyears,imonths,idates,ihours)
              call date_make_big(iyears,imonths,idates,ihours,itotdate_current)
              if (lastdate_sst(ifm)<itotdate_current) then
                 isendflg = 1
                 isendbackflg = 1 ! ALF
                 isendsst = 1 ! ALF
                 !return
              endif
           endif
        enddo
     endif

  endif

  if (iupdndvi  ==  1 ) then
     do ifm = 1,ngrids
        if (ndviflg(ifm)==1) then
           if (timemf>=ndvitime2(ifm) .and. timemf<timmax) then
              isendflg = 1
              isendbackflg = 1 ! ALF
              isendndvi = 1
              !return
           endif
        endif
     enddo
  endif

  if (if_cuinv  ==  1 ) then
     do ifm = 1,ngrids
        if (timemf  >=  cu_times(ncufl+1) .and.  &
             timemf  <  timmax) then
           isendflg = 1
           isendbackflg = 1 ! ALF
           !return
        endif
     enddo
  endif

  return
end subroutine comm_time_new

!-------------------------------------------------------------------------

subroutine rams_output()

  use mem_varinit, only: &
       nud_type,  & ! INTENT(IN)
       htime2,    & ! INTENT(IN) 
       nud_cond,  & ! INTENT(IN)
       condtime2, & ! INTENT(IN)
       vtime2       ! INTENT(IN)

  use mem_cuparm, only: &
       if_cuinv,  & ! INTENT(IN)
       cutime2      ! INTENT(IN)

  use io_params, only: &
       frqprt,  & ! INTENT(IN)
       INITFLD, & ! INTENT(IN)
       frqhis,  & ! INTENT(IN)
       frqanl,  & ! INTENT(IN)
       frqlite, & ! INTENT(IN)
       frqmean, & ! INTENT(IN)
       frqboth, & ! INTENT(IN)
       avgtim,  & ! INTENT(IN)
       iupdsst, & ! INTENT(IN)
       iupdndvi   ! INTENT(IN)

  use mem_grid, only: &
       ngrids,        & ! INTENT(IN)
       nzp, nxp, nyp, & ! INTENT(IN)
       npatch,        & ! INTENT(IN)
       time,          & ! INTENT(IN)
       dtlongn,       & ! INTENT(IN)
       iflag,         & ! INTENT(IN)
       timmax,        & ! INTENT(IN)
       iyear1,        & ! INTENT(IN)
       imonth1,       & ! INTENT(IN)
       idate1,        & ! INTENT(IN)
       itime1           ! INTENT(IN)

  use node_mod, only: &
       ia, iz, ja, jz                  ! INTENT(IN)


!--(DMK-CCATT)---------------------------------------------------------
  !srf - chem
  use chem_sources, only: le_sourcemaps,srctime2,SRCMAPFN

  USE chem1_list, ONLY:           &
       chem_nspecies=>nspecies,   &
       spc_chem_alloc=>spc_alloc, &
       src,                       &
       off,                       &
       spc_chem_name =>spc_name,  &
       on,                        &
       chemical_mechanism,        &
       emiss_ajust,               &
       CO

  USE mem_chem1, ONLY:               &
       nsrc,                         &
       nvert_src=>chem1_src_z_dim_g, &
       chem1_src_g,                  &
       bburn,                        &
       src_name,                     &
       chemistry,                    &
       ntimes_src,                   &
       diur_cycle

  USE aer1_list, ONLY:           &
       aer_nspecies=>nspecies,   &
       spc_aer_alloc=>spc_alloc, & 
       spc_aer_name =>aer_name,  &
       urban,                    &
       nucle,                    &
       accum

  USE mem_aer1, ONLY:  &
       aer1_g,         &
       nmodes,         &
       aerosol

  USE mem_plume_chem1, ONLY: &
       nveg_agreg,           &
       plume_mean_g

  USE mem_plume_chem1, ONLY: &
       tropical_forest,      &
       boreal_forest,        &
       savannah,             &
       grassland,            &
       plume_g

  USE chem1_list, ONLY:           &
       transport

  USE aer1_list, ONLY:           &
       aer_bburn => bburn 

  USE grid_dims, ONLY: &
       nzpmax

  USE mem_grid, ONLY: &
       dzt,           &
       grid_g

  !srf - chem - end
  ![ML
  use mem_turb
  use mem_stilt
  !ML]
!--(DMK-original)------------------------------------------------------
!  ! CATT
!  use emission_source_map, only: read_emission_sources_map ! Subroutine
!--(DMK-CCATT-END)-----------------------------------------------------

  ! CATT
  use catt_start, only: CATT           ! intent(in)

  ! TEB_SPM
  use teb_spm_start, only: TEB_SPM      ! INTENT(IN)
  use mem_emiss, only : isource         ! INTENT(IN)

  implicit none

  ! Local Variables
  integer :: ierr, ifm   !,ifileok
  real :: frqqueim  ! CATT


  if (TEB_SPM==1) then
     !EDF  emission module %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     !----------------------------------------
     if(isource==1)then
        ifm=ngrids
        call newgrid(ifm)
        CALL le_fontes(ifm, nzp, nxp, nyp, npatch, ia, iz, ja, jz) 
     endif
     !EDF%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  endif

  do ifm = 1,ngrids
     call newgrid(ifm)

     if((mod(time,frqprt)<dtlongn(1).and.INITFLD==1) .or.iflag == 1)then
        call prtout()
        !c            call uwcomp(a)
     endif

  enddo

  if(mod(time,frqhis) < dtlongn(1).or.  &
       time  >=  timmax - .01*dtlongn(1) .or.  &
       iflag == 1)then
     call hiswrt('no')
  endif

  if(mod(time,frqanl) < dtlongn(1).or.  &
       time  >=  timmax - .01*dtlongn(1) .or.  &
       iflag == 1)then

!--(DMK-CCATT)---------------------------------------------------------
     !---------------------------------------------------------------
     !-ml/srf 19feb2003 - RAMS-STILT coupling ---------------------------
     if (imassflx == 1) then
        do ifm=1, ngrids
           !----- Advection flux ------------------------------------------------------------------!
           call output_mean_at_inst_analysis_advec(nzp,nxp,nyp                                 &
                ,stilt_g(ifm)%afxub(1,1,1),  stilt_g(ifm)%afxvb(1,1,1)                         &
                ,stilt_g(ifm)%afxwb(1,1,1), stiltm_g(ifm)%afxu(1,1,1)                          &
                ,stiltm_g(ifm)%afxv(1,1,1), stiltm_g(ifm)%afxw(1,1,1))
           !----- TKE, not available for all closures... -------------------------------------------!
           if (idiffk(ifm) /= 2 .and. idiffk(ifm) /= 3) then
              call output_mean_at_inst_analysis_tke(nzp,nxp,nyp                                 &
                   ,stilt_g(ifm)%tkepb(1,1,1),  turbm_g(ifm)%tkep(1,1,1))
           end if
           !----- Sigma-W and Lagrangian time scale, available only if IDIFFK=7 (Nakanishi) --------!
           if (idiffk(ifm) == 7) then
              call output_mean_at_inst_analysis_turb(nzp,nxp,nyp                                &
                   ,stilt_g(ifm)%sigwb(1,1,1),  stilt_g(ifm)%ltscaleb(1,1,1)                    &
                   ,stiltm_g(ifm)%sigw(1,1,1),  stiltm_g(ifm)%ltscale(1,1,1))
           end if
        end do
     end if
     !-ml/srf ----------------------------------------------------------
     !---------------------------------------------------------------
!--(DMK-CCATT-END)-----------------------------------------------------

     call anlwrt('no','INST')
     !cc         CALL UWCOMP(A)
  endif

  !     Call the analysis writing routine again for the other var types
  if(frqlite > 0.) then
     if( mod(time,frqlite) < dtlongn(1).or.  &
          time  >=  timmax - .01*dtlongn(1) ) then
        call anlwrt('no','LITE')
     endif
  endif

  if (frqmean>0.) then
     if(avgtim > 0.0.and.mod(time-avgtim/2.,frqmean) < dtlongn(1)  &
          .and.time >= avgtim) call anlwrt('no','MEAN')
     if(avgtim < 0.0.and.mod(time,frqmean) < dtlongn(1))  &
          call anlwrt('no','MEAN')
  endif

  if (frqboth>0.) then
     if(avgtim > 0.0.and.mod(time-avgtim/2.,frqboth) < dtlongn(1)  &
          .and.time >= avgtim)call anlwrt('no','BOTH')
     if(avgtim < 0.0.and.mod(time,frqboth) < dtlongn(1))  &
          call anlwrt('no','BOTH')
  endif

  if (iupdsst  ==  1) then
     do ifm = 1,ngrids
        call sst_read(3,ifm,ierr)
     enddo
  endif

  if (iupdndvi  ==  1) then
     do ifm = 1,ngrids
        call ndvi_read(3,ifm,ierr)
     enddo
  endif

  if( nud_type == 1 .and. time >= htime2  &
       .and.time+.00001 < timmax) then
     call nud_read(2)
  endif

  if( nud_cond == 1 .and. time >= condtime2  &
       .and.time+.00001 < timmax) then
     call cond_read(2)
  endif

  if(if_cuinv == 1 .and. time >= cutime2  &
       .and.time+.00001 < timmax) then
     call cu_read(2)
  endif

  if(nud_type==2) then
     if (time>=vtime2 .and. time+.0001<timmax) then
        call varf_read(2)
     endif
  endif

  ! CATT
!--(DMK-CCATT)---------------------------------------------------------
  if (CATT == 1 ) then

    if (CHEMISTRY >= 0 .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'NONE' &
                       .and. SRCMAPFN(1:len_trim(SRCMAPFN)) /= 'none') then

     !time para leitura dos mapas de queimadas
     !frqqueim=24.*3600.
     !inicializando as fontes as 00UTC
     !if ( mod(time + 0.01*itime1*3600.,frqqueim) .lt. dtlongn(1) .and. &
     !     time.ge.0.*3600.  .and. time+.0001 < timmax) then
     
     if(time>=srctime2 .and. time+.0001<timmax) then
     
        print*,'----------------------------------------------'
        do ifm = 1,ngrids
           call newgrid(ifm)
           print*,'-> chem sources maps reading: ',time/3600.,' grid=',ifm
!           call le_sourcemaps(ifm,nzp,nxp,nyp)
           call le_sourcemaps(ifm,nzp,nxp,nyp,time,iyear1,imonth1,idate1,itime1,ngrids,timmax, &
                              chem_nspecies,spc_chem_alloc,src,off,nsrc,nvert_src,chem1_src_g, &
                              bburn,spc_chem_name,on,chemical_mechanism,emiss_ajust,co,        &
                              aer_nspecies,spc_aer_alloc,spc_aer_name,urban,nucle,accum,       &
                              src_name,chemistry,ntimes_src,aer1_g,nmodes,aerosol,nveg_agreg,  &
                              plume_mean_g,nzpmax,dzt,grid_g(ifm)%rtgt,transport,aer_bburn,    &
                              plume_g,tropical_forest,boreal_forest,savannah,grassland,diur_cycle)

        enddo
        print*,'----------------------------------------------'

     endif
    endif
     !----srf-
  endif

  if (iflag==1) stop 'IFLAG'

  return
end subroutine rams_output
